Practice10
데이터 불러오기
path <- 'https://raw.githubusercontent.com/Paul-scpark/Data_Mining_Practicum/main/data/'
ori_train <- read.csv(paste0(path, 'motion_train.csv'), header = T)
test <- read.csv(paste0(path, 'motion_test.csv'), header = T)
paste0('Size of train data: ', dim(ori_train))## [1] "Size of train data: 7352" "Size of train data: 563"paste0('Size of test data: ', dim(test))## [1] "Size of test data: 2947" "Size of test data: 563"table(ori_train$Activity)##
## LAYING SITTING STANDING WALKING
## 1407 1286 1374 1226
## WALKING_DOWNSTAIRS WALKING_UPSTAIRS
## 986 1073table(test$Activity)##
## LAYING SITTING STANDING WALKING
## 537 491 532 496
## WALKING_DOWNSTAIRS WALKING_UPSTAIRS
## 420 471ori_train %>%
group_by(Activity) %>%
summarise(count = n()) %>%
arrange(count) %>%
ggplot(aes(x = reorder(Activity, -count), y = count)) +
geom_bar(stat = 'identity') + xlab('Activity') +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
geom_text(aes(label = count), vjust = 1.5, colour = 'white')
가장 먼저는 주어진 데이터를 불러오도록 한다. Kaggle에서 데이터를 다운 받은 후에 train과 test 데이터를 불러온다.
각 데이터의 size를 먼저 확인해보면, train 데이터는 (7352, 563)이고, test 데이터는 (2947, 563) 이라는 것을 확인할 수 있다.
두 데이터의 변수 개수가 같은 것으로 보아, train 데이터 뿐 아니라, test 데이터에서도 target 변수를 가지고 있음을 확인할 수 있다.
Target 변수인 Activity 변수에 대해 train, test 각각에 대해 table로 전반적인 분포를 확인한다.
그리고 직관적으로 이해할 수 있도록 bar plot을 통해서 Laying - Standing - Sitting - Walking - Walking Upstairs - Walking Downstairs 값을 확인한다.
문제 1. train과 valid dataset으로 나눠서 Logistic regression 분류기 만들기 (Multi-class)
sum(colSums(is.na(ori_train)))## [1] 0sum(colSums(is.na(test)))## [1] 0ori_train <- ori_train %>%
transform(laying = ifelse(Activity == 'LAYING', 1, 0),
sitting = ifelse(Activity == 'SITTING', 1, 0),
standing = ifelse(Activity == 'STANDING', 1, 0),
walking = ifelse(Activity == 'WALKING', 1, 0),
walking_down = ifelse(Activity == 'WALKING_DOWNSTAIRS', 1, 0),
walking_up = ifelse(Activity == 'WALKING_UPSTAIRS', 1, 0))
train_idx <- createDataPartition(ori_train$Activity, p = c(0.8, 0.2), list = F)
train <- ori_train[train_idx, ]
valid <- ori_train[-train_idx, ]
dim(train)## [1] 5884 569dim(valid)## [1] 1468 569table(train$Activity) / nrow(train)##
## LAYING SITTING STANDING WALKING
## 0.1913664 0.1748810 0.1869477 0.1667233
## WALKING_DOWNSTAIRS WALKING_UPSTAIRS
## 0.1340925 0.1459891table(valid$Activity) / nrow(valid)##
## LAYING SITTING STANDING WALKING
## 0.1914169 0.1750681 0.1866485 0.1668937
## WALKING_DOWNSTAIRS WALKING_UPSTAIRS
## 0.1341962 0.1457766가장 먼저는 모델링을 하기 전에 각 데이터에서 NA의 여부를 확인하여, NA가 없음을 확인한다.
그 후에는 Target 변수인 Activity 변수에 대해 transform 함수를 통해 Dummy coding 처리를 해주도록 한다.
그리고 나서는 train 데이터를 train과 valid dataset을 8:2 비율로 나눠서 모델의 성능을 파악하고, 반복하여 모델을 개선하도록 한다.
이를 위해 caret 패키지의 createDataPartition 함수를 이용하는데, 그 이유는 target 변수들의 분포가 한쪽으로 치우치지 않고, 잘 분배된 상태로 나눠주기 때문이다.
이를 통한 결과를 확인해보면, train과 valid 데이터셋에서 각 target 변수 별로 그 분포가 유사한 것을 확인할 수 있다.
train_X <- train %>%
select(-subject, -Activity, -laying, -sitting, -standing, -walking, -walking_down, -walking_up)
train_y <- train %>%
select(laying, sitting, standing, walking, walking_down, walking_up)
valid_X <- valid %>%
select(-subject, -Activity, -laying, -sitting, -standing, -walking, -walking_down, -walking_up)
valid_y <- valid %>%
select(laying, sitting, standing, walking, walking_down, walking_up)
dim(train_X)## [1] 5884 561dim(train_y)## [1] 5884 6dim(valid_X)## [1] 1468 561dim(valid_y)## [1] 1468 6그리고 나서는 학습을 위해 Input 변수와 Target(Label) 변수를 각각 train_X, train_y 형태로 나눠주도록 한다.
이때, train 함수는 학습에 의미가 떨어지는 subject 변수부터 Label 변수를 제외해주도록 한다.
또한 이를 train과 valid 데이터 각각으로 Input과 Label 데이터프레임을 나눠준다.
model_list <- list()
for (i in 1:6){
model_list[[colnames(train_y)[i]]] <- glm(data = cbind(train_y[i], train_X),
formula = paste0(colnames(train_y)[i], '~.'),
family = binomial(link = 'logit'))
}
names(model_list)## [1] "laying" "sitting" "standing" "walking" "walking_down"
## [6] "walking_up"train과 valid 데이터셋이 준비되었다면, Logistic Regression 모델을 만들어보도록 한다.
train 데이터의 Input 변수가 500개가 넘는 복잡한 모델이 되긴 하겠지만, 처음에는 일단 모든 변수를 넣고 모델링을 해보도록 한다.
for 반복문을 통해서 각 변수를 분류하는 6개 모델을 각각 만들어서 list에 저장하도록 한다.
학습이 끝난 후에 모델이 담겨 있는 model_list의 이름을 출력해보면, 6개 모델이 있는 것을 확인할 수 있다.
valid_df <- data.frame(matrix("", nrow = nrow(valid_X)))[-1]
for (model in names(model_list)){
valid_df <- cbind(valid_df, predict(model_list[model], newdata = valid_X, type = 'response'))
}
valid_df <- valid_df %>%
mutate(pred = apply(valid_df, 1, which.max),
pred = ifelse(pred == 1, 'LAYING',
ifelse(pred == 2, 'SITTING',
ifelse(pred == 3, 'STANDING',
ifelse(pred == 4, 'WALKING',
ifelse(pred == 5, 'WALKING_DOWNSTAIRS', 'WALKING_UPSTAIRS'))))),
actual = valid$Activity)
head(valid_df, 10)## laying sitting standing walking walking_down
## 3 2.220446e-16 2.220446e-16 1.000000e+00 4.850559e-12 2.220446e-16
## 6 2.220446e-16 2.220446e-16 1.000000e+00 2.220446e-16 2.711305e-13
## 10 2.220446e-16 2.220446e-16 1.000000e+00 2.220446e-16 1.936554e-13
## 12 2.220446e-16 2.220446e-16 1.000000e+00 7.500973e-13 2.195776e-10
## 14 4.155198e-13 4.793902e-06 1.000000e+00 4.573123e-13 1.281478e-13
## 25 3.312269e-12 2.220446e-16 1.000000e+00 2.220446e-16 2.220446e-16
## 28 2.220446e-16 1.000000e+00 2.220446e-16 2.220446e-16 2.220446e-16
## 35 2.220446e-16 1.000000e+00 2.220446e-16 2.220446e-16 2.220446e-16
## 43 2.220446e-16 1.000000e+00 2.220446e-16 2.220446e-16 2.220446e-16
## 45 2.220446e-16 1.000000e+00 2.220446e-16 2.220446e-16 1.471658e-13
## walking_up pred actual
## 3 2.220446e-16 STANDING STANDING
## 6 2.220446e-16 STANDING STANDING
## 10 2.220446e-16 STANDING STANDING
## 12 2.220446e-16 STANDING STANDING
## 14 2.220446e-16 STANDING STANDING
## 25 5.396335e-11 STANDING STANDING
## 28 2.220446e-16 SITTING SITTING
## 35 2.259958e-12 SITTING SITTING
## 43 2.580616e-12 SITTING SITTING
## 45 2.220446e-16 SITTING SITTINGtrain 데이터를 이용해서 학습이 끝났다면, valid 데이터를 이용하여 성능을 평가해보도록 한다.
각 row 별로 6개 모델을 이용한 예측 확률값을 담은 데이터프레임을 가장 먼저 만들어주도록 한다.
그리고 나서는 확률값 중에서 가장 높은 값을 갖는 변수로 pred 변수를 만들어주고, 실제 값을 actual로 붙여주도록 한다.
head 함수를 통해서 전반적인 형태를 확인하면, 위와 같음을 확인할 수 있다.
table(valid_df$pred, valid_df$actual)##
## LAYING SITTING STANDING WALKING WALKING_DOWNSTAIRS
## LAYING 281 0 0 0 0
## SITTING 0 241 9 2 6
## STANDING 0 16 265 2 3
## WALKING 0 0 0 241 0
## WALKING_DOWNSTAIRS 0 0 0 0 187
## WALKING_UPSTAIRS 0 0 0 0 1
##
## WALKING_UPSTAIRS
## LAYING 0
## SITTING 2
## STANDING 2
## WALKING 0
## WALKING_DOWNSTAIRS 0
## WALKING_UPSTAIRS 210mean(valid_df$pred == valid_df$actual)## [1] 0.9707084train 데이터로 학습한 모델에 대하여 valid 데이터를 예측한 값에 대한 결과를 비교해본다.
pred와 actual에 대해 table 함수를 통해서 confusion matrix 형태를 만들어서 결과를 본다.
결과를 확인해보면, 약 0.95 정도의 결과를 확인할 수 있다.
모델의 성능이 낮은 것은 아니지만, 500개 이상의 변수가 포함된 복잡한 모델이라고 할 수 있다.
따라서 feature engineering을 통해 조금 단순화 시켜서 최적화를 시켜보도록 한다.
문제 2. Feature Engineering을 통해서 모델을 최적화해보기
# CASE 1. 각 Activity 별로 motion에 대한 Std 값이 큰 변수 확인
train_sd <- train %>%
select(-laying, -sitting, -standing, -walking, -walking_down, -walking_up) %>%
group_by(Activity) %>%
summarise_each(funs(sd))
train_sd <- cbind(c('LAYING', 'SITTING', 'STANDING', 'WALKING', 'WALKING_DOWNSTAIRS', 'WALKING_UPSTAIRS', 'STD'),
rbind(train_sd[, -1], apply(train_sd[, -1], 2, sd)))
colnames(train_sd)[1] <- 'variable'
train_sd <- train_sd[, names(train_sd) != 'subject']
train_sd <- as.data.frame(t(train_sd))
colnames(train_sd) <- train_sd[1, ]
train_sd <- train_sd[-1, ]
train_sd$variable <- rownames(train_sd)
train_sd[, 1:7] <- as.data.frame(sapply(train_sd[, 1:7], as.double))
rownames(train_sd) <- NULL
head(train_sd[order(train_sd$STD, decreasing = T), ], 5)## LAYING SITTING STANDING WALKING WALKING_DOWNSTAIRS
## 557 0.3596564 0.3334721 0.50535130 0.66565170 0.82927170
## 58 0.5265178 0.1520386 0.06296275 0.05534072 0.05428164
## 59 0.5617620 0.1834241 0.07964106 0.09162635 0.08391948
## 300 0.5463359 0.4475090 0.40959420 0.13711580 0.13538520
## 209 0.3848173 0.3614653 0.34065073 0.05807477 0.05216887
## WALKING_UPSTAIRS STD variable
## 557 0.83684080 0.2235705 angle.tBodyGyroMean.gravityMean.
## 58 0.08012120 0.1855736 tGravityAcc.energy...Y
## 59 0.16191125 0.1855080 tGravityAcc.energy...Z
## 300 0.23229190 0.1736159 fBodyAcc.kurtosis...Y
## 209 0.05968972 0.1680214 tBodyAccMag.entropy..head(train_sd[order(train_sd$STD, decreasing = F), ], 5)## LAYING SITTING STANDING WALKING WALKING_DOWNSTAIRS WALKING_UPSTAIRS
## 31 0.1656205 0.1747833 0.1823908 0.1805360 0.1792367 0.1777179
## 108 0.2016427 0.2063253 0.2155354 0.2187220 0.2154189 0.2078790
## 117 0.2203204 0.2269936 0.2209659 0.2188683 0.2281165 0.2372822
## 197 0.2403598 0.2460586 0.2402771 0.2313076 0.2290877 0.2273735
## 112 0.2324016 0.2341154 0.2396877 0.2522119 0.2387783 0.2269602
## STD variable
## 31 0.006016628 tBodyAcc.arCoeff...Y.2
## 108 0.006615728 tBodyAccJerk.arCoeff...X.3
## 117 0.006917068 tBodyAccJerk.arCoeff...Z.4
## 197 0.007513992 tBodyGyroJerk.arCoeff...Z.4
## 112 0.008617194 tBodyAccJerk.arCoeff...Y.3이번에는 Feature Engineering 과정을 통해서 기존에 500개 이상의 변수를 사용했던 것을 조금 단순화 시켜보도록 한다.
가장 먼저는 각 Activity 별로 group_by 해서 각 변수들의 값들의 변동이 심한 변수들을 통해 결과를 살펴보도록 한다.
이를 통해 각 motion에 대한 변수들 중에서 기본적으로 움직임이 없는 즉, 모든 Activity에 대해서 변동성이 작은 변수는 기본 자세를 취하는 등으로 판단했다.
따라서 laying, sitting, standing, walking, walking_up, walking_down의 행동에 대해 각 데이터의 Standard deviation을 구하도록 한다.
이를 통해 다른 동작은 움직임이 적지만, 특정 동작에 있어서는 움직임이 크다고 판단되는 변수들의 지표로 표준편차를 사용하도록 한다.
최종적으로 각 Activity 별로 표준편차를 계산하고, 그 후에는 각 variable 별로 표준편차를 계산하여 값이 큰 변수를 우선적으로 사용하도록 한다.
summary(train_sd$STD)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.006017 0.052425 0.082580 0.077826 0.101940 0.223571target_variable <- train_sd %>%
filter(STD >= 0.13) %>%
select(variable) %>%
c()
target_variable## $variable
## [1] "tGravityAcc.energy...Y"
## [2] "tGravityAcc.energy...Z"
## [3] "tBodyAccJerk.mean...X"
## [4] "tBodyGyro.mean...X"
## [5] "tBodyGyro.entropy...Z"
## [6] "tBodyAccMag.entropy.."
## [7] "tGravityAccMag.entropy.."
## [8] "tBodyGyroJerkMag.entropy.."
## [9] "fBodyAcc.maxInds.X"
## [10] "fBodyAcc.skewness...Y"
## [11] "fBodyAcc.kurtosis...Y"
## [12] "fBodyAcc.bandsEnergy...17.24"
## [13] "fBodyAcc.bandsEnergy...17.32"
## [14] "fBodyAcc.bandsEnergy...9.16.1"
## [15] "fBodyAccJerk.bandsEnergy...17.32"
## [16] "fBodyAccJerk.bandsEnergy...17.24.1"
## [17] "fBodyGyro.std...Y"
## [18] "fBodyGyro.max...Y"
## [19] "fBodyGyro.iqr...Y"
## [20] "fBodyGyro.bandsEnergy...1.8.1"
## [21] "fBodyGyro.bandsEnergy...1.24.1"
## [22] "fBodyAccMag.kurtosis.."
## [23] "fBodyBodyAccJerkMag.min.."
## [24] "angle.tBodyAccMean.gravity."
## [25] "angle.tBodyAccJerkMean..gravityMean."
## [26] "angle.tBodyGyroMean.gravityMean."각 변수 별로 계산된 표준편차를 summary 함수를 통해 전반적인 수치를 확인해본다.
결과를 확인해보면, max는 약 0.22, 3rd quantile은 약 0.10 정도가 나오는 것을 확인할 수 있다.
이 과정에서는 기존 500개가 넘는 변수들에서 조금이나마 Input 변수를 줄이는 것이 목표이므로, 0.13 정도를 기준으로 filtering을 수행한다.
이를 통해 target_variable은 25개가 나오는 것을 확인할 수 있다.
var1 <- target_variable$variable[1:12]
var2 <- target_variable$variable[13:24]
train %>%
select(var1, Activity) %>%
gather(key, value, 1:12) %>%
ggplot(aes(x = value, fill = Activity)) +
geom_density(alpha = 0.2) +
facet_wrap(~ key, scales = 'free_y')
train %>%
select(var2, Activity) %>%
gather(key, value, 1:12) %>%
ggplot(aes(x = value, fill = Activity)) +
geom_density(alpha = 0.2) +
facet_wrap(~ key, scales = 'free_y')
이 과정이 마무리 된 후에는 시각화를 통해서 전반적으로 변수 별로 분포의 차이가 있는지 결과를 확인해본다.
총 25개 변수 중에서 12개씩 나눠서 2개의 plot을 그려보았다.
표준편차가 크다는 것은 각 Activity 별로의 범위가 크다는 즉, 변동성이 크다는 것을 다시 한번 plot으로 확인할 수 있다.
이 변수들을 통해 train 데이터로부터 모델링을하고, valid 데이터로 결과를 확인해보도록 한다.
model_list <- list()
for (i in 1:6){
model_list[[colnames(train_y)[i]]] <- glm(data = cbind(train_y[i],
train_X[, names(train_X) %in% target_variable$variable]),
formula = paste0(colnames(train_y)[i], '~.'),
family = binomial(link = 'logit'))
}
valid_df <- data.frame(matrix("", nrow = nrow(valid_X)))[-1]
for (model in names(model_list)){
valid_df <- cbind(valid_df, predict(model_list[model], newdata = valid_X, type = 'response'))
}
valid_df <- valid_df %>%
mutate(pred = apply(valid_df, 1, which.max),
pred = ifelse(pred == 1, 'LAYING',
ifelse(pred == 2, 'SITTING',
ifelse(pred == 3, 'STANDING',
ifelse(pred == 4, 'WALKING',
ifelse(pred == 5, 'WALKING_DOWNSTAIRS', 'WALKING_UPSTAIRS'))))),
actual = valid$Activity)
table(valid_df$pred, valid_df$actual)##
## LAYING SITTING STANDING WALKING WALKING_DOWNSTAIRS
## LAYING 281 0 0 0 0
## SITTING 0 164 68 0 0
## STANDING 0 93 202 0 1
## WALKING 0 0 3 200 20
## WALKING_DOWNSTAIRS 0 0 0 25 149
## WALKING_UPSTAIRS 0 0 1 20 27
##
## WALKING_UPSTAIRS
## LAYING 0
## SITTING 0
## STANDING 1
## WALKING 21
## WALKING_DOWNSTAIRS 9
## WALKING_UPSTAIRS 183mean(valid_df$pred == valid_df$actual)## [1] 0.8031335위와 같은 과정으로 표준편차가 컸던 상위 25개 변수들을 추린 target_variable을 활용하여 각 Activity를 예측할 수 있는 이진분류 모델을 만든다.
그리고 valid 데이터를 이용하여 6개의 모델을 적용해서 가장 확률값이 컸던 Activity로 분류하도록 한다.
이를 통해 최종적으로 valid 데이터셋에 있는 실제값과 예측값의 confusion matrix를 그려보도록 한다.
그 후에는 실제와 예측이 일치한 것에 대해서 평균값을 계산해보면, 약 0.84 정도의 수치가 나오는 것을 볼 수 있다.
1번에서 500개 이상의 변수를 넣었을 때보다는 확실히 결과값이 감소한 것을 확인할 수 있다.
그렇다면, 다른 방식으로 feature engineering을 할 수 없을까 고민하다가, Random Forest를 활용해 보기로 했다.
# CASE 2. Random Forest 알고리즘을 통해 Feature Importance 확인
new_train <- train[, !names(train) %in% c('subject', 'laying', 'sitting',
'standing', 'walking', 'walking_down', 'walking_up')]
new_train$Activity <- as.factor(new_train$Activity)
rf_model <- randomForest(new_train$Activity ~ ., data = new_train, )
varImpPlot(rf_model)
앞서 이야기했듯, 1번에서의 모델링을 약 500개가 넘는 너무 많은 변수로 학습시킨 모델이라고 할 수 있다.
500차원이 넘어가는 모델은 너무 복잡도가 크기 때문에 Feature selection 과정이 필요하다.
이를 위해서 시도해본 것은 Random Forest 알고리즘의 Feature Importance를 확인하는 것이었다.
Random Forest 알고리즘은 gini-index 값을 기준으로 각 변수의 중요도를 계산해줄 수 있다.
따라서 이를 plot을 통해서 결과를 확인해보면, 위와 같음을 확인할 수 있다.
결과를 보면, tGravityAcc.min, tGravityAcc.mean, angly.Y.gravityMean, tGravityAcc.max 등의 변수들이 중요도가 높은 것으로 확인된다.
rf_importance <- as.data.frame(rf_model$importance)
rf_importance$variable <- rownames(rf_importance)
rf_importance <- rf_importance[order(rf_importance$MeanDecreaseGini),]
input_variable <- tail(rf_importance$variable, 30)
input_variable## [1] "fBodyAccJerk.energy...X" "tGravityAcc.arCoeff...Y.2"
## [3] "tBodyAccJerk.std...X" "fBodyAccMag.std.."
## [5] "tGravityAcc.energy...Z" "tGravityAcc.arCoeff...Y.1"
## [7] "tGravityAcc.arCoeff...Z.3" "fBodyAccMag.mad.."
## [9] "tGravityAcc.arCoeff...Z.2" "tGravityAccMag.std.."
## [11] "tGravityAcc.arCoeff...Z.1" "fBodyAccJerk.bandsEnergy...1.24"
## [13] "tGravityAcc.min...Z" "angle.Z.gravityMean."
## [15] "tGravityAcc.mean...Z" "fBodyAccMag.energy.."
## [17] "tBodyAcc.max...X" "tGravityAcc.max...Z"
## [19] "fBodyAccJerk.bandsEnergy...1.8" "fBodyAccJerk.bandsEnergy...1.16"
## [21] "tGravityAcc.energy...Y" "tGravityAcc.mean...Y"
## [23] "tGravityAcc.max...X" "tGravityAcc.mean...X"
## [25] "tGravityAcc.max...Y" "tGravityAcc.min...Y"
## [27] "angle.X.gravityMean." "angle.Y.gravityMean."
## [29] "tGravityAcc.energy...X" "tGravityAcc.min...X"따라서 중요도가 높은 변수들을 내림차순으로 정렬하여 Target 변수에 영향을 많이 미치는 30 변수를 채택하도록 한다.
이 역시 해당 변수들을 추려서 시각화를 통해서 전반적인 분포가 어떻게 생겼는지 확인해보도록 한다.
var1 <- input_variable[1:12]
var2 <- input_variable[13:24]
train %>%
select(var1, Activity) %>%
gather(key, value, 1:12) %>%
ggplot(aes(x = value, fill = Activity)) +
geom_density(alpha = 0.2) +
facet_wrap(~ key, scales = 'free_y')
train %>%
select(var2, Activity) %>%
gather(key, value, 1:12) %>%
ggplot(aes(x = value, fill = Activity)) +
geom_density(alpha = 0.2) +
facet_wrap(~ key, scales = 'free_y')
앞선 plot과 유사하게 Activity와 변수 별로 전반적인 분포를 위와 같이 확인할 수 있다.
그리고 나서는 기존 500개 이상의 변수에서 30개로 줄인 변수를 통해서 다시 모델링을 수행해보고, 결과를 확인하도록 한다.
model_list <- list()
for (i in 1:6){
model_list[[colnames(train_y)[i]]] <- glm(data=cbind(train_y[i],train_X[,names(train_X) %in% input_variable]),
formula = paste0(colnames(train_y)[i], '~.'),
family = binomial(link = 'logit'))
}
valid_df <- data.frame(matrix("", nrow = nrow(valid_X)))[-1]
for (model in names(model_list)){
valid_df <- cbind(valid_df, predict(model_list[model], newdata = valid_X, type = 'response'))
}
valid_df <- valid_df %>%
mutate(pred = apply(valid_df, 1, which.max),
pred = ifelse(pred == 1, 'LAYING',
ifelse(pred == 2, 'SITTING',
ifelse(pred == 3, 'STANDING',
ifelse(pred == 4, 'WALKING',
ifelse(pred == 5, 'WALKING_DOWNSTAIRS', 'WALKING_UPSTAIRS'))))),
actual = valid$Activity)
table(valid_df$pred, valid_df$actual)##
## LAYING SITTING STANDING WALKING WALKING_DOWNSTAIRS
## LAYING 281 0 0 0 0
## SITTING 0 208 30 0 0
## STANDING 0 47 244 0 0
## WALKING 0 0 0 232 3
## WALKING_DOWNSTAIRS 0 2 0 7 187
## WALKING_UPSTAIRS 0 0 0 6 7
##
## WALKING_UPSTAIRS
## LAYING 0
## SITTING 0
## STANDING 0
## WALKING 5
## WALKING_DOWNSTAIRS 6
## WALKING_UPSTAIRS 203mean(valid_df$pred == valid_df$actual)## [1] 0.9230245채택된 30개 변수를 추린 후에는 앞선 과정과 동일하게 6개 target 변수에 대해 분류 가능한 모델을 학습하여 list에 할당한다.
그리고나서는 valid 데이터셋에 대해 모델을 적용하여 결과를 비교 및 평가해보도록 한다.
최종적으로 결과를 확인해보면, 약 0.93 정도의 값이 나오는 것을 확인할 수 있다.
모든 변수를 다 넣었던 1번에서는 정확도가 완벽한 1이 나왔는데, 확실히 변수를 줄이니 그 결과 역시 소폭 감소함을 확인할 수 있다.
첫번째로 확인했던 단순히 표준편차로만 비교했던 것보다는 결과가 소폭 상승한 것을 확인할 수 있었고, 이를 통해 최종 모델을 만들어보도록 한다.
문제 3. Feature Engineering 후, test 데이터에 모델 적용해보기
final_train_X <- ori_train %>%
select(-subject, -Activity, -laying, -sitting, -standing, -walking, -walking_down, -walking_up)
final_train_y <- ori_train %>%
select(laying, sitting, standing, walking, walking_down, walking_up)
dim(final_train_X)## [1] 7352 561dim(final_train_y)## [1] 7352 6최종 모델에서는 기존에 train과 valid를 나눴던 것을 모두 합쳐서 모델링을 하도록 한다.
2번 과정에서 결과를 보면, Random Forest의 변수 중요도로부터 결과를 비교한 것이 valid 데이터에서 결과가 더 좋았다.
따라서 해당 변수들을 통해서 최종 모델링을 수행하여 test 데이터에서 결과를 비교해보도록 한다.
model_list <- list()
for (i in 1:6){
model_list[[colnames(final_train_y)[i]]] <- glm(data=cbind(final_train_y[i],
final_train_X[,names(final_train_X) %in% input_variable]),
formula = paste0(colnames(final_train_y)[i], '~.'),
family = binomial(link = 'logit'))
}
test_df <- data.frame(matrix("", nrow = nrow(test)))[-1]
for (model in names(model_list)){
test_df <- cbind(test_df, predict(model_list[model], newdata = test[, names(test) %in% input_variable], type = 'response'))
}
test_df <- test_df %>%
mutate(pred = apply(test_df, 1, which.max),
pred = ifelse(pred == 1, 'LAYING',
ifelse(pred == 2, 'SITTING',
ifelse(pred == 3, 'STANDING',
ifelse(pred == 4, 'WALKING',
ifelse(pred == 5, 'WALKING_DOWNSTAIRS', 'WALKING_UPSTAIRS'))))),
actual = test$Activity)
table(test_df$pred, test_df$actual)##
## LAYING SITTING STANDING WALKING WALKING_DOWNSTAIRS
## LAYING 537 0 0 0 0
## SITTING 0 361 64 0 0
## STANDING 0 125 467 0 0
## WALKING 0 0 0 474 32
## WALKING_DOWNSTAIRS 0 2 0 4 334
## WALKING_UPSTAIRS 0 3 1 18 54
##
## WALKING_UPSTAIRS
## LAYING 0
## SITTING 0
## STANDING 4
## WALKING 47
## WALKING_DOWNSTAIRS 10
## WALKING_UPSTAIRS 410mean(test_df$pred == test_df$actual)## [1] 0.8764846최종적인 final_train 데이터에 대해서 약 25개 정도로 추린 input_variable로 최종 Logistic 모델을 만들어서 list에 담는다.
그리고 나서, test 데이터에 대해 각 모델들을 활용하여 가장 확률이 높았던 Activity를 분류하도록 한다.
마지막으로는 위에서 했던 과정과 유사하게, 예측값과 실제값의 결과를 비교해보도록 한다.
최종적인 결과는 기존 500개가 넘는 변수에서 30개를 사용하여 약 0.87 정도가 나오는 것을 확인할 수 있다.
참고. glm을 사용하지 않고, 직접 구현한 모델을 이용한 Logistic modeling
path <- 'https://raw.githubusercontent.com/Paul-scpark/Data_Mining_Practicum/main/data/'
ori_train <- read.csv(paste0(path, 'motion_train.csv'), header = T)
test <- read.csv(paste0(path, 'motion_test.csv'), header = T)
train_idx <- createDataPartition(ori_train$Activity, p = c(0.8, 0.2), list = F)
train_df <- ori_train[train_idx, ]
valid_df <- ori_train[-train_idx, ]위와 동일하게 데이터를 부른 후에, createDataPartition 함수를 이용하여 train과 valid 데이터로 나눠주도록 한다.
feature.df <- train_df[, 1:562]
y <- data.frame(train_df[, 563], val = 1, i = as.integer(rownames(train_df)))
rownames(y) <- y$i
head(y)## train_df...563. val i
## 2 STANDING 1 2
## 3 STANDING 1 3
## 4 STANDING 1 4
## 5 STANDING 1 5
## 6 STANDING 1 6
## 9 STANDING 1 9y.new <- (y %>% spread(key = train_df...563., value = val, fill = 0))
rownames(y.new) <- y.new$i
y.new <- y.new[-1]
head(y.new)## LAYING SITTING STANDING WALKING WALKING_DOWNSTAIRS WALKING_UPSTAIRS
## 2 0 0 1 0 0 0
## 3 0 0 1 0 0 0
## 4 0 0 1 0 0 0
## 5 0 0 1 0 0 0
## 6 0 0 1 0 0 0
## 9 0 0 1 0 0 0데이터의 행 순서가 조금 달라서 matrix 연산에 약간의 이슈가 있음을 확인할 수 있다.
train_df <- train_df[order(as.numeric(row.names(train_df))), ]
feature.df <- feature.df[order(as.numeric(row.names(feature.df))), ]
y <- y[ order(as.numeric(row.names(y))), ]
head(train_df[1:6, 1:6], 3)## tBodyAcc.mean...X tBodyAcc.mean...Y tBodyAcc.mean...Z tBodyAcc.std...X
## 2 0.2784188 -0.01641057 -0.1235202 -0.9982453
## 3 0.2796531 -0.01946716 -0.1134617 -0.9953796
## 4 0.2791739 -0.02620065 -0.1232826 -0.9960915
## tBodyAcc.std...Y tBodyAcc.std...Z
## 2 -0.9753002 -0.9603220
## 3 -0.9671870 -0.9789440
## 4 -0.9834027 -0.9906751head(feature.df[1:6, 1:6], 3)## tBodyAcc.mean...X tBodyAcc.mean...Y tBodyAcc.mean...Z tBodyAcc.std...X
## 2 0.2784188 -0.01641057 -0.1235202 -0.9982453
## 3 0.2796531 -0.01946716 -0.1134617 -0.9953796
## 4 0.2791739 -0.02620065 -0.1232826 -0.9960915
## tBodyAcc.std...Y tBodyAcc.std...Z
## 2 -0.9753002 -0.9603220
## 3 -0.9671870 -0.9789440
## 4 -0.9834027 -0.9906751head(y, 3)## train_df...563. val i
## 2 STANDING 1 2
## 3 STANDING 1 3
## 4 STANDING 1 4train 데이터와 feature 데이터 그리고 target 변수를 담고 있는 데이터프레임을 재배열하고, 일치하는 것을 확인해주도록 한다.
theta <- rep(0, ncol(feature.df))
## hypothesis function
g <- function(z) {1 / (1 + exp(-z))}
h <- function(theta, X) {g(X %*% theta)}
## cost function
J <- function(X, y, theta) {(1 / length(y)) * sum(-y*log(h(theta, X))-(1-y)*log(1-h(theta, X)))}
## Gradient
gR <- function(X, y, theta) {
error <- h(theta, X) - y
delta <- t(X) %*% error / length(y)
return(delta)
}로지스틱 회귀를 위하여 Hypothesis와 cost 함수 그리고 Gradient를 정의해주도록 한다.
그리고 나서는 각각을 분류할 수 있는 모델을 만들어본다.
theta <- rep(0, ncol(feature.df))
ucminf_out_1 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[1]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[1]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_2 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[2]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[2]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_3 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[3]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[3]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_4 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[4]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[4]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_5 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[5]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[5]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_6 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[6]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[6]%>%as.matrix, t)
)Target 변수인 Laying, Sitting, Standing, Walking, Walking up, Walking down에 대하여 one to all 기법으로 모델을 학습한다.
pred1 <- feature.df%>%as.matrix %*% ucminf_out_1$par%>%as.matrix
pred2 <- feature.df%>%as.matrix %*% ucminf_out_2$par%>%as.matrix
pred3 <- feature.df%>%as.matrix %*% ucminf_out_3$par%>%as.matrix
pred4 <- feature.df%>%as.matrix %*% ucminf_out_4$par%>%as.matrix
pred5 <- feature.df%>%as.matrix %*% ucminf_out_5$par%>%as.matrix
pred6 <- feature.df%>%as.matrix %*% ucminf_out_6$par%>%as.matrix
prediction <- data.frame(LAYING = pred1, SITTING = pred2,
STANDING = pred3, WALKING = pred4,
WALKING_DOWNSTAIRS = pred5, WALKING_UPSTAIRS = pred6)
prediction <- prediction %>%
mutate(pred_final = colnames(prediction)[apply(prediction,1,which.max)])
train_Acc <- data.frame(actual = y[,1], predict = prediction$pred_final)
sum(train_Acc$actual == train_Acc$predict) / nrow(train_Acc)## [1] 0.99065266가지에 대해 matrix 연산을 해주고, 최종적으로 확률값이 가장 높은 항목에 대해서 예측값을 정해주도록 한다.
그리고 train에 대하여 결과를 확인해보면, 약 99% 정도로 전반적으로 학습이 잘되었고, 이를 valid 데이터셋에서도 적용해보도록 한다.
valid_feature <- valid_df[, 1:562]
valid_y <- data.frame(actual = valid_df[, 563], val = 1, i = as.integer(rownames(valid_df)))
rownames(valid_y) <- valid_y$i
valid_y.new <- (valid_y %>% spread(key = actual, value = val, fill = 0))
rownames(valid_y.new) <- valid_y.new$i
valid_y.new <- valid_y.new[-1]
head(valid_feature[1:6, 1:6], 3)## tBodyAcc.mean...X tBodyAcc.mean...Y tBodyAcc.mean...Z tBodyAcc.std...X
## 1 0.2885845 -0.02029417 -0.1329051 -0.9952786
## 7 0.2794539 -0.01964078 -0.1100221 -0.9969210
## 8 0.2774325 -0.03048830 -0.1253604 -0.9965593
## tBodyAcc.std...Y tBodyAcc.std...Z
## 1 -0.9831106 -0.9135264
## 7 -0.9671859 -0.9831178
## 8 -0.9667284 -0.9815853head(valid_y)## actual val i
## 1 STANDING 1 1
## 7 STANDING 1 7
## 8 STANDING 1 8
## 15 STANDING 1 15
## 18 STANDING 1 18
## 21 STANDING 1 21head(valid_y.new)## LAYING SITTING STANDING WALKING WALKING_DOWNSTAIRS WALKING_UPSTAIRS
## 1 0 0 1 0 0 0
## 7 0 0 1 0 0 0
## 8 0 0 1 0 0 0
## 15 0 0 1 0 0 0
## 18 0 0 1 0 0 0
## 21 0 0 1 0 0 0valid 데이터에 대하여 데이터프레임과 그 순서, 정렬을 확인해보도록 한다.
v_pred1 <- valid_feature%>%as.matrix %*% ucminf_out_1$par%>%as.matrix
v_pred2 <- valid_feature%>%as.matrix %*% ucminf_out_2$par%>%as.matrix
v_pred3 <- valid_feature%>%as.matrix %*% ucminf_out_3$par%>%as.matrix
v_pred4 <- valid_feature%>%as.matrix %*% ucminf_out_4$par%>%as.matrix
v_pred5 <- valid_feature%>%as.matrix %*% ucminf_out_5$par%>%as.matrix
v_pred6 <- valid_feature%>%as.matrix %*% ucminf_out_6$par%>%as.matrix
v_prediction <- data.frame(LAYING = v_pred1, SITTING = v_pred2,
STANDING = v_pred3, WALKING = v_pred4,
WALKING_DOWNSTAIRS = v_pred5, WALKING_UPSTAIRS = v_pred6)
v_prediction <- v_prediction %>%
mutate(pred_final = colnames(v_prediction)[apply(v_prediction,1,which.max)])
validation_Acc <- data.frame(actual = valid_y[,1], predict = v_prediction$pred_final)
sum(validation_Acc$actual == validation_Acc$predict) / nrow(validation_Acc)## [1] 0.9754768valid 데이터에 대해 정확도를 계산해보면, 약 0.98 정도의 값을 확인할 수 있다.
다만, 2% 차이이지만, error 값의 배율은 2배 정도이다.
어느 정도는 overfitting이 되었고, Regularization 등의 기법을 통해서 그 복잡도를 일부 낮출 필요가 있다고 생각된다.
feature.df <- ori_train[, 1:562]
y <- data.frame(actual = ori_train[, 563], val = 1, i = as.integer(rownames(ori_train)))
rownames(y) <- y$i
y.new <- (y %>% spread(key = actual, value = val, fill = 0))
rownames(y.new) <- y.new$i
y.new <- y.new[-1]
head(feature.df[1:6, 1:6], 3)## tBodyAcc.mean...X tBodyAcc.mean...Y tBodyAcc.mean...Z tBodyAcc.std...X
## 1 0.2885845 -0.02029417 -0.1329051 -0.9952786
## 2 0.2784188 -0.01641057 -0.1235202 -0.9982453
## 3 0.2796531 -0.01946716 -0.1134617 -0.9953796
## tBodyAcc.std...Y tBodyAcc.std...Z
## 1 -0.9831106 -0.9135264
## 2 -0.9753002 -0.9603220
## 3 -0.9671870 -0.9789440head(y, 3)## actual val i
## 1 STANDING 1 1
## 2 STANDING 1 2
## 3 STANDING 1 3head(y.new, 3)## LAYING SITTING STANDING WALKING WALKING_DOWNSTAIRS WALKING_UPSTAIRS
## 1 0 0 1 0 0 0
## 2 0 0 1 0 0 0
## 3 0 0 1 0 0 0최종적으로 test에 대해 결과를 확인하기 위하여 기존에 train과 valid로 나눴던 것을 모두 합친 데이터로 학습을 하려고 한다.
따라서 기존의 전체 train 데이터로 모델을 학습하여, test 데이터에 결과를 확인해보도록 한다.
theta <- rep(0, ncol(feature.df))
ucminf_out_1 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[1]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[1]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_2 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[2]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[2]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_3 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[3]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[3]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_4 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[4]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[4]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_5 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[5]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[5]%>%as.matrix, t)
)
theta <- rep(0, ncol(feature.df))
ucminf_out_6 <- ucminf(
par = theta,
fn = function(t) J(feature.df%>%as.matrix, y.new[6]%>%as.matrix, t),
gr = function(t) gR(feature.df%>%as.matrix, y.new[6]%>%as.matrix, t)
)동일한 방식으로 train 데이터에 대해 모델을 학습하도록 한다.
test_feature <- test[, 1:562]
test_y <- data.frame(actual = test[, 563])
pred1 <- test_feature%>%as.matrix %*% ucminf_out_1$par%>%as.matrix
pred2 <- test_feature%>%as.matrix %*% ucminf_out_2$par%>%as.matrix
pred3 <- test_feature%>%as.matrix %*% ucminf_out_3$par%>%as.matrix
pred4 <- test_feature%>%as.matrix %*% ucminf_out_4$par%>%as.matrix
pred5 <- test_feature%>%as.matrix %*% ucminf_out_5$par%>%as.matrix
pred6 <- test_feature%>%as.matrix %*% ucminf_out_6$par%>%as.matrix
prediction <- data.frame(LAYING = pred1, SITTING = pred2,
STANDING = pred3, WALKING = pred4,
WALKING_DOWNSTAIRS = pred5, WALKING_UPSTAIRS = pred6)
prediction <- prediction %>%
mutate(pred_final = colnames(prediction)[apply(prediction,1,which.max)])
test_Acc <- data.frame(actual = test_y$actual, predict = prediction$pred_final)
sum(test_Acc$actual == test_Acc$predict) / nrow(test_Acc)## [1] 0.9511367모델의 정확도는 약 0.95 정도가 나오는 것을 볼 수 있고, 모델을 만드는 과정에서 약간의 overfitting 되었다고 판단된다.
그래도 특별한 전처리 없이 기존의 모든 변수를 활용한 것에 대해서는 나름 성능이 괜찮다고 판단된다.
그럼에도 Regularization을 통해서 Overfitting을 줄일 수 있는지 확인해보도록 한다.
Jv_reg <- function(X, y, theta, lambda) {
m <- length(y)
theta1 <- theta
theta1[1] <- 0
reg <- (lambda/(2*m)) * crossprod(theta1, theta1)
-(1/m) * crossprod(
c(y, 1-y),
c(log(h(theta, X)), log(1-h(theta, X)))
) + reg
}
gRv_reg <- function(X, y, theta, lambda) {
m <- length(y)
reg <- (lambda/m) * theta
error <- h(theta,X) - y
delta <- crossprod(X, error) / m
return(delta + reg)
}
err <- function(y, pred) {
test_that(
"Prediction and actual are the same length",
expect_equal(length(y), length(pred))
)
error <- 1 - mean(y == (pred >= 0.5))
error <- round(error, 2)
return(error)
}
reg_lr <- function(X, y, theta, lambda) {
ucminf_out <- ucminf(
par = theta,
fn = function(t) Jv_reg(X, y, t, lambda),
gr = function(t) gRv_reg(X, y, t, lambda)
)
error <- err(y, h(ucminf_out$par, X))
return(list(theta = as.vector(ucminf_out$par),
error = error))
}규제가 있는 모델을 구현하기 위해 필요한 함수들을 만들어준다.
theta <- rep(0, ncol(feature.df))
reg_lr_out_1 <- reg_lr ( X = feature.df %>% as.matrix, y = y.new[1] %>% as.matrix, theta = theta, lambda = 1)## Test passed 🎉theta <- rep(0, ncol(feature.df))
reg_lr_out_2 <- reg_lr ( X = feature.df %>% as.matrix, y = y.new[2] %>% as.matrix, theta = theta, lambda = 1)## Test passed 🎊theta <- rep(0, ncol(feature.df))
reg_lr_out_3 <- reg_lr ( X = feature.df %>% as.matrix, y = y.new[3] %>% as.matrix, theta = theta, lambda = 1)## Test passed 🥳theta <- rep(0, ncol(feature.df))
reg_lr_out_4 <- reg_lr ( X = feature.df %>% as.matrix, y = y.new[4] %>% as.matrix, theta = theta, lambda = 1)## Test passed 🥳theta <- rep(0, ncol(feature.df))
reg_lr_out_5 <- reg_lr ( X = feature.df %>% as.matrix, y = y.new[5] %>% as.matrix, theta = theta, lambda = 1)## Test passed 😀theta <- rep(0, ncol(feature.df))
reg_lr_out_6 <- reg_lr ( X = feature.df %>% as.matrix, y = y.new[6] %>% as.matrix, theta = theta, lambda = 1)## Test passed 🌈reg_pred1 <- test_feature%>%as.matrix %*% reg_lr_out_1$theta%>%as.matrix
reg_pred2 <- test_feature%>%as.matrix %*% reg_lr_out_2$theta%>%as.matrix
reg_pred3 <- test_feature%>%as.matrix %*% reg_lr_out_3$theta%>%as.matrix
reg_pred4 <- test_feature%>%as.matrix %*% reg_lr_out_4$theta%>%as.matrix
reg_pred5 <- test_feature%>%as.matrix %*% reg_lr_out_5$theta%>%as.matrix
reg_pred6 <- test_feature%>%as.matrix %*% reg_lr_out_6$theta%>%as.matrix
reg_prediction <- data.frame(LAYING = reg_pred1, SITTING = reg_pred2,
STANDING = reg_pred3, WALKING = reg_pred4,
WALKING_DOWNSTAIRS = reg_pred5, WALKING_UPSTAIRS = reg_pred6)
reg_prediction <- reg_prediction %>%
mutate(pred_final = colnames(reg_prediction)[apply(reg_prediction,1,which.max)])
test_Acc_reg <- data.frame(actual = test_y$actual, predict = reg_prediction$pred_final)
sum(test_Acc_reg$actual == test_Acc_reg$predict) / nrow(test_Acc_reg)## [1] 0.9613166lambda 값을 적용하여 규제가 있는 모델을 만들어보았다.
모델의 최종 결과는 약 0.96 정도로 약간의 개선이 있긴 했지만, 다른 lambda 값들도 적용하거나, 추가적인 전처리가 된다면 성능을 보다 개선시킬 수 있을 것 같다.
이를 통해 로지스틱 회귀를 직접 구현하여 multi-class를 분류하는 모델을 만들어 볼 수 있었다.